home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / Libraries / PNL Libraries / MyResources.p < prev    next >
Encoding:
Text File  |  1995-03-19  |  2.5 KB  |  118 lines  |  [TEXT/CWIE]
  1. unit MyResources;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Resources;
  7.         
  8.     const
  9.         res_by_id = 0;
  10.         res_by_name = -1;
  11.  
  12.     type
  13.         ResourceObject = record
  14.                 data: handle;
  15.                 fs: FSSpec;
  16.                 typ: ResType;
  17.                 id: integer;
  18.                 name: str255;
  19.                 attributes: integer;
  20.                 readonly: boolean;
  21.             end;
  22.  
  23.     function GetResourceObject (var res: ResourceObject; index: integer): OSErr;
  24.     function PutResourceObject (var res: ResourceObject): OSErr;
  25.     procedure DestroyResourceObject (var res: ResourceObject);
  26.  
  27. implementation
  28.  
  29.     uses
  30.         Errors;
  31.         
  32.     procedure DestroyResourceObject (var res: ResourceObject);
  33.     begin
  34.         DisposeHandle(res.data);
  35.         res.data := nil;
  36.     end;
  37.  
  38.     function GetResourceObject (var res: ResourceObject; index: integer): OSErr;
  39.         var
  40.             h: handle;
  41.             err: OSErr;
  42.             resfile: integer;
  43.     begin
  44.         res.data := nil;
  45.         res.readonly := false;
  46.         SetResLoad(false);
  47.         resfile := FSpOpenResFile(res.fs, fsRdWrPerm);
  48.         err := ResError;
  49.         if err <> noErr then begin
  50.             res.readonly := true;
  51.             resfile := FSpOpenResFile(res.fs, fsRdPerm);
  52.             err := ResError;
  53.         end;
  54.         if err = noErr then begin
  55.             if index = res_by_id then begin
  56.                 h := Get1Resource(res.typ, res.id);
  57.             end
  58.             else if index = res_by_name then begin
  59.                 h := Get1NamedResource(res.typ, res.name);
  60.             end
  61.             else begin
  62.                 h := Get1IndResource(res.typ, index);
  63.             end;
  64.             if h = nil then begin
  65.                 if index > 0 then begin
  66.                     err := resNotFound;
  67.                 end
  68.                 else if res.readonly then begin
  69.                     err := wrPermErr;
  70.                 end;
  71.                 res.attributes := 0;
  72.             end
  73.             else begin
  74.                 GetResInfo(h, res.id, res.typ, res.name);
  75.                 res.attributes := GetResAttrs(h);
  76.                 SetResAttrs(h, 0);
  77.                 SetResLoad(true);
  78.                 h := Get1Resource(res.typ, res.id);
  79.                 SetResAttrs(h, res.attributes);
  80.                 DetachResource(h);
  81.                 res.data := h;
  82.             end;
  83.             CloseResFile(resfile);
  84.         end;
  85.         SetResLoad(true);
  86.         GetResourceObject := err;
  87.     end;
  88.  
  89.     function PutResourceObject (var res: ResourceObject): OSErr;
  90.         var
  91.             h: handle;
  92.             err: OSErr;
  93.             resfile: integer;
  94.     begin
  95.         SetResLoad(false);
  96.         resfile := FSpOpenResFile(res.fs, fsRdWrPerm);
  97.         err := ResError;
  98.         if err = noErr then begin
  99.             h := Get1Resource(res.typ, res.id);
  100.             if h <> nil then begin
  101. {    SetResInfo(h, -1, 'Backup');}
  102.                 RemoveResource(h);
  103.             end;
  104.             AddResource(res.data, res.typ, res.id, res.name);
  105.             err := ResError;
  106.             if err = noErr then begin
  107.                 WriteResource(res.data);
  108.                 SetResAttrs(res.data, res.attributes);
  109.                 err := ResError;
  110.                 DetachResource(res.data);
  111.             end;
  112.             CloseResFile(resfile);
  113.         end;
  114.         SetResLoad(true);
  115.         PutResourceObject := err;
  116.     end;
  117.  
  118. end.